Developer CD Series 1994 November: Tool Chest/Dev.CD Nov 94.toast/Tool Chest/OS Utilities/Feature Teller 1.0/Feature Teller.π

Text File | 1991-09-10 | 17.1 KB | 727 lines | [TEXT/PJMM]

{* ----------------------------------------------------------------------------     *}
{*                                                                                                       *}
{*        Apple Macintosh Developer Techincal Support                                               *}
{*                                                                                                       *}
{*       Feature Teller                                                                               *}
{*                                                                                                       *}
{*        Feature Teller.π        -     Think Pascal 3.0 Source Code                                *}
{*                                                                                                       *}
{*        Copyright ©  Apple Computer,  Inc.  1991                                                *}
{*        All rights reserved.                                                                           *}
{*                                                                                                       *}
{*        Written by Jennifer Minge                                                                *}
{*                                                                                                       *}
{*        Versions:                                                                                    *}
{*                        1.00                09/91                                                    *}
{*                                                                                                       *}
{*        Components:                                                                                *}
{*                        Feature Teller.π                    Sept.   5,  1991                        *}
{*                        Feature Teller                    Sept.   5,  1991                        *}
{*                        Feature Teller.rsrc                Sept.   5,  1991                        *}
{*                        Feature Teller.app                Sept.   5,  1991                        *}
{*                                                                                                       *}
{*        Feature Teller is an example program that demonstrates how to use the Gestalt    *}
{*        Manger to determine the features installed on the Macintosh.  Information            *}
{*        that is returned is:                                                                        *}
{*                                                                                                       *}
{*                        CPU type                                                                    *}
{*                        Processor model                                                            *}
{*                        PMU type                                                                    *}
{*                        Keyboard type                                                            *}
{*                        AppleTalk version                                                        *}
{*                        Amount of memory                                                        *}
{*                        Address mode                                                                *}
{*                        AppleEvents status                                                        *}
{*                        Comm Toolbox version                                                    *}
{*                        Presence of parity memory                                                *}
{*                                                                                                       *}
{*            The program writes the information to the console window which is            *}
{*            presented by the Think Pascal compiler.                                            *}
{*                                                                                                       *}
{*            This program is designed to be a reference on how to handle calls                *}
{*            to the Gestalt manager.  This program is not designed as a reference            *}
{*            for a full blown program that provides a proper user interface.                    *}
{*                                                                                                       *}
{*----------------------------------------------------------------------------- *}


program FeatureTeller;


    const
        BASE_RES_ID = 128;                        { beginning resource id for menus }
        ABOUT_ALERT = 128;                        { About box  resource id }

        SLEEP = 60;                                    { value used for WaitNextEvent }
        WNE_TRAP_NUM = $60;
        UNIMPL_TRAP_NUM = $9F;

        APPLE_MENU_ID = BASE_RES_ID;            { Resource id for the Apple menu }
        ABOUT_ITEM = 1;

        FILE_MENU_ID = BASE_RES_ID + 1;        { Resource id for the File menu }
        QUIT_ITEM = 1;

        EDIT_MENU_ID = BASE_RES_ID + 2;        { Resource if for the Edit menu }
        CUT_ITEM = 1;
        COPY_ITEM = 2;
        PASTE_ITEM = 3;
        CLEAR_ITEM = 4;

        SYS_VERSION = 2;                            { SysEnvirons version information }
        NIL_STRING = ' ';


    var
        gDone, gWNEImpLemented: BooLean;
        gTheEvent: EventRecord;

{-----------------------> END OF DECLARATIONS <-----------------}


{----------------> CloseSysWindow <---------------------}
{  This routine handles the closing of desk accessory windows }
{-------------------------------------------------------}
    procedure CloseSysWindow;
        var
            whichWindow: WindowPeek;
            accNumber: INTEGER;

    begin
        whichWindow := WindowPeek(FrontWindow);

        accNumber := whichWindow^.windowKind;
        CloseDeskAcc(accNumber);
    end;


{ *****************   HandleEditChoice  ** ***************}
{*  This routines handles event parsing if the user clicks in the Edit menu  *}
{************************************************}

    procedure HandleEditChoice (theItem: INTEGER);
        var
            itemType: INTEGER;
            editMenu: MenuHandle;

    begin
        editMenu := GetMHandle(EDIT_MENU_ID);
        case theItem of
            CUT_ITEM:
                SysBeep(20);
            COPY_ITEM:
                SysBeep(20);
            PASTE_ITEM:
                SysBeep(20);
            CLEAR_ITEM:
                SysBeep(20);
        end;
    end;


{ *************** HandleFileChoice  *********************}
{*  This routines handles event parsing if the user clicks in the File menu  *}
{************************************************}

    procedure HandleFileChoice (theItem: INTEGER);
        var
            itemType: INTEGER;
            fileMenu: MenuHandle;

    begin
        fileMenu := GetMHandle(FILE_MENU_ID);
        case theItem of
            QUIT_ITEM:
                begin
                    CloseSysWindow;
                    gDone := TRUE;
                end;
        end;
    end;



{ *************** HandleAppleChoice  *********************}
{*  This routines handles event parsing if the user clicks in the Apple menu   *}
{**************************************************}

    procedure HandleAppleChoice (theItem: INTEGER);
        var
            accName: Str255;
            accNumber, dummY: INTEGER;
            itemType: INTEGER;
            appleMenu: MenuHandle;

    begin
        case theItem of
            ABOUT_ITEM:
                dummy := NoteAlert(ABOUT_ALERT, nil);
            otherwise
                begin
                    appleMenu := GetMHandle(APPLE_MENU_ID);
                    GetItem(appleMenu, theItem, accName);
                    accNumber := OpenDeskAcc(accName);
                end;
        end;
    end;



{ *************** HandleMenuChoice  *********************}
{*  This routines which menu item the user clicks on and then calls the        *}
{*  appropriate routine to handle events in the correct menu.                  *}
{*************************************************}

    procedure HandleMenuChoice (menuChoice: LONGINT);
        var
            theMenu, theItem: INTEGER;

    begin
        if menuChoice <> 0 then
            begin
                theMenu := HiWord(menuChoice);
                theItem := LoWord(menuChoice);

                case theMenu of
                    400:
                        HandleAppleChoice(theItem);
                    FILE_MENU_ID:
                        HandleFileChoice(theItem);
                    EDIT_MENU_ID:
                        HandleEditChoice(theItem);
                end;

                HiliteMenu(0);
            end;
    end;



{ ***************** HandleMouseDown  ***********************}
{*  This routines determines where a user clicks and calls the appropriate routine *}
{*****************************************************}

    procedure HandleMouseDown;
        var
            whichWindow: WindowPtr;
            thePart: INTEGER;
            menuChoice, windSize: LONGINT;

    begin
        thePart := FindWindow(gTheEvent.where, whichWindow);
        case thePart of
            inMenuBar:
                begin
                    menuChoice := MenuSelect(gTheEvent.where);
                    HandleMenuChoice(menuChoice);
                end;

            inSysWindow:
                SystemClick(gTheEvent, whichWindow);

            inContent:
                SysBeep(20);

            inDrag:
                DragWindow(whichWindow, gTheEvent.where, screenBits.bounds);

            inGrow:
                SysBeep(20);

            inGoAway:
                begin
                    if TrackGoAway(whichWindow, gTheEvent.where) then
                        begin
                            if FrontWindow = whichWindow then
                                DisposeWindow(whichWindow)
                            else
                                CloseSysWindow;
                        end;
                end;

            InZoomIn:
                SysBeep(20);

            InZoomOut:
                SysBeep(20);
        end;
    end;



{ ****************** HandleEvent  *********************}
{*  This routines calls either WaitNextEvent or GetNextEvent depending    *}
{*  on which routine is supported.    This is the main event loop.                *}
{************************************************}

    procedure HandleEvent;
        var
            theChar: CHAR;
            dummy: BOOLEAN;

    begin
        if gWNEImplemented then
            dummy := WaitNextEvent(everyEvent, gTheEvent, SLEEP, nil)
        else
            begin
                SystemTask;
                dummy := GetNextEvent(everyEvent, gTheEvent);
            end;


        case gTheEvent.what of
            mouseDown:
                HandleMouseDown;
            keyDown, autoKey:
                begin
                    theChar := CHR(BitAnd(gTheEvent.message, charCodeMask));
                    if (BitAnd(gTheEvent.modifiers, cmdKey) <> 0) then
                        HandleMenuChoice(MenuKey(theChar));
                end;
        end;
    end;



{ ***************** MainLoop  ************************}
{*  This routines repeats until the user selects Quit                             *}
{************************************************}

    procedure MainLoop;
    begin
        gDone := FALSE;
        gWNEImplemented := (NGetTrapAddress(WNE_TRAP_NUM, ToolTrap) <> NGetTrapAddress(UNIMPL_TRAP_NUM, ToolTrap));
        while gDone = FALSE do
            HandleEvent;
    end;



{ ****************** MenuBarInit  *********************}
{*  This routines draws the Menu Bar which is read in from a Resource file *}
{************************************************}

    procedure MenuBarInit;
        var
            myMenuBar: Handle;
            aMenu: MenuHandle;

    begin
        myMenuBar := GetNewMBar(BASE_RES_ID);
        SetMenuBar(myMenuBar);
        DisposHandle(myMenuBar);

        aMenu := GetMenu(APPLE_MENU_ID);
        AddResMenu(aMenu, 'DRVR');

        aMenu := GetMenu(FILE_MENU_ID);
        InsertMenu(aMenu, 0);

        aMenu := GetMenu(EDIT_MENU_ID);
        InsertMenu(aMenu, 0);

        DrawMenuBar;
    end;



{ *************** NumToHexString  *********************}
{*  This routine converts from a number to hexadecimal                         *}
{************************************************}

    function NumToHexString (theInt: LONGINT; numBytes: INTEGER): STR255;
        var
            myArray: string[16];
            myString: string[8];
            x: INTEGER;

    begin
        myArray := '0123456789ABCDEF';
        myString := myArray[BAND(theInt, $0F) + 1];
        for x := 1 to (numBytes * 2 - 1) do
            begin
                theInt := BSR(theInt, 4);
                myString := Concat(myArray[BAND(theInt, $0F) + 1], myString);
            end;
        NumToHexString := MyString;
    end;



{ ******************* Gestalt  *********************}
{*  Inline code to call the Gestalt Manager                                      *}
{************************************************}

    function Gestalt (code: OSType; var feature: LONGINT): OSErr;

    inline
        $225F, {MOVE.L (SP)+,A0}
        $201F, {MOVE.L (SP)+,D0}
        $A1AD, {_Gestalt}
        $2288, {MOVE.L A0, (A1)}
        $3E80; {MOVE.W, D0,(SP)}



{ ***************** UseGestalt  *********************}
{*  This routines places all of the Gestalt calls                             *}
{************************************************}

    procedure UseGestalt;
        var
            status: OSErr;
            Dummy, theError, x: integer;
            theString, aString: Str255;
            theMachine, theAddress, memory, bytes: LONGINT;

    begin
        InitCursor;
        ShowText;

        theError := Gestalt('mach', theMachine);
        case theMachine of
            1:
                writeln('Macintosh 128K');
            2:
                writeln('Macintosh XL');
            3:
                writeln('Macintosh 512KE');
            4:
                writeln('Macintosh Plus');
            5:
                writeln('Macintosh SE');
            6:
                writeln('Macintosh II');
            7:
                writeln('Macintosh IIx');
            8:
                writeln('Machintosh IIcx');
            9:
                writeln('Macintosh SE/30');
            10:
                writeln('Macintosh Portable');
            11:
                writeln('Macintosh IIci');
            13:
                writeln('Macintosh IIfx');
            17:
                writeln('Macintosh Classic');
            18:
                writeln('Macintosh IIsi');
            19:
                writeln('Macintosh LC');
            otherwise
                writeln('Machine type = ', theMachine);
        end;


        theError := Gestalt('proc', theMachine);
        case theMachine of
            1:
                writeln('MC68000 processor');
            2:
                writeln('MC68010 processor');
            3:
                writeln('MC68020 processor');
            4:
                writeln('MC68030 processor');
            5:
                writeln('MC68040 processor');
            otherwise
                writeln('processor = ', theMachine);
        end;


        theError := Gestalt('fpu ', theMachine);
        case theMachine of
            0:
                writeln('No FPU installed');
            1:
                writeln('68881 installed');
            2:
                writeln('68882 installed');
            otherwise
                writeln('PMU type = ', theMachine);
        end;


        theError := Gestalt('kbd ', theMachine);
        case theMachine of
            1:
                writeln('Macintosh keyboard');
            2:
                writeln('Macintosh keyboard with keypad');
            3:
                writeln('Mac Plus keyboard');
            4:
                writeln('Macintosh Extended keyboard');
            5:
                writeln('Macintosh Standard keyboard');
            6:
                writeln('Portable keyboard');
            7:
                writeln('Portable ISO keyboard');
            8:
                writeln('Standard ISO keyboard');
            9:
                writeln('Extended ISO keyboard');
            10:
                writeln('ADB keyboard II');
            11:
                writeln('ADB ISO keyboard II');
            otherwise
                writeln('keyboard type = ', theMachine);
        end;

        theError := Gestalt('atlk', theMachine);
        NumToString(theMachine, aString);
        if (aString = '0') then
            writeln('AppleTalk not installed')
        else
            writeln('Appletalk version = ', aString);

        theError := Gestalt('ram ', theMachine);
        memory := theMachine div 1048576;
        NumToString(memory, aString);
        writeln('Memory = ', aString, ' Megs');

        theError := Gestalt('addr', theMachine);
        case theMachine of
            1:
                writeln('32 bit addressing enabled');
            2:
                writeln('32 bit clean block headers');
            3:
                writeln('32 bit capable');
            otherwise
                begin
                    NumToString(theMachine, aString);
                    writeln('Address mode = ', aString);
                end;
        end;

        theError := gestalt('evnt', theMachine);
        case theMachine of
            0:
                writeln('AppleEvents are present');
            otherwise
                writeln('AppleEvents are not present');
        end;

        theError := gestalt('ctbv', theMachine);
        NumToString(theMachine, aString);
        writeln('Comm Toolbox version = ', aString);


        theError := gestalt('prty', theMachine);
        if (theMachine = 0) then
            writeln('Parity Memory not installed')
        else
            writeln('Parity Memory installed');
    end;



{ *************** NumToolboxTraps  *********************}
{*  This routine checks to see what Toolbox traps are available on the mac  *}
{*************************************************}

    function NumToolboxTraps: INTEGER;
        const
            _InitGraf = $A86E;

    begin
        if NGetTrapAddress(_InitGraf, ToolTrap) = NGetTrapAddress($AA6E, ToolTrap) then
            NumToolboxTraps := $200
        else
            NumToolboxTraps := $400;
    end;



{ *************** GetTrapType  ************************}
{*  This routine checks to see what Toolbox traps are available on the mac  *}
{*************************************************}

    function GetTrapType (theTrap: INTEGER): TrapType;
        const
            TrapMask = $0800;

    begin
        if BAND(theTrap, TrapMask) > 0 then
            GetTrapType := ToolTrap
        else
            GetTrapType := OSTrap;
    end;


{ *************** TrapAvailable  ************************}
{*  This routine checks to see what Toolbox traps are available on the mac  *}
{*************************************************}

    function TrapAvailable (theTrap: INteger): boolean;
        const
            _Unimplemented = $9F;

        var
            tType: TrapType;

    begin
        tType := GetTrapType(theTrap);
        if tType = ToolTrap then
            begin
                theTrap := BAND(theTrap, $07FF);
                if theTrap >= NumToolboxTraps then
                    theTrap := _Unimplemented;
            end;
        TrapAvailable := NgetTrapAddress(theTrap, tType) <> NGetTrapAddress(_Unimplemented, ToolTrap);
    end;


{ *************** GestaltAvailable  ************************}
{*  This routine checks to see if Gestalt is supported on the Mac.                  *}
{***************************************************}

    function GestaltAvailable: Boolean;
        const
            _Gestalt = $A1AD;

    begin
        GestaltAvailable := TrapAvailable(_Gestalt);
    end;


{ ***************** UseSysEnviron  ************************}
{*  This routine places all of the calls to SysEnviron if Gestalt is not supported  *}
{****************************************************}
    procedure UseSysEnviron;
        var
            MPPOpen, status: OSErr;
            SysEnvData: SysEnvRec;
            dummy: INTEGER;
            FPU, CQD: BOOLEAN;
            memory: LONGINT;
            aString: STR255;
            numBytes: INTEGER;

    begin
        InitCursor;
        ShowText;

        status := SysEnvirons(SYS_VERSION, SysEnvData);
        memory := SysEnvData.systemVersion;
        numBytes := 2;
        astring := NumToHexString(memory, numBytes);
        writeln('System version = ', aString);
        case SysEnvData.machineType of
            0:
                writeln('Machine type unknown');
            -1:
                writeln('Fat Mac');
            -2:
                writeln('MacintoshXL/Lisa');
            1:
                writeln('Macintosh 512K enhanced');
            2:
                writeln('Macintosh Plus');
            3:
                writeln('Macintosh SE');
            4:
                writeln('Macintosh II');
            5:
                writeln('Macintosh IIx');
            6:
                writeln('Macintosh IIcx');
            7:
                writeln('Macintosh SE/30');

            9:
                writeln('Macintosh IIci');
            11:
                writeln('Macintosh IIfx');

            17:
                writeln('Macintosh LC');
            20:
                writeln('Machine type = Spike');
            otherwise
                writeln('Machine type = ', SysEnvData.machineType);
        end;

        case SysEnvData.processor of
            0:
                writeln('Unrecogonized processor');
            1:
                writeln('MC68000 processor');
            2:
                writeln('MC68010 processor');
            3:
                writeln('MC68020 processor');
            4:
                writeln('MC68030 processor');
            5:
                writeln('MC68040 processor');
            otherwise
                writeln('processor = ', SysEnvData.processor);
        end;

        if (SysEnvData.hasFPU) then
            writeln('Floating Point processor installed')
        else
            writeln('Floating Point processor not installed');

        if (SysEnvData.hasColorQD) then
            writeln('Color QuickDraw installed')
        else
            writeln('Color QuickDraw not installed');

        case SysEnvData.keyBoardType of
            0:
                writeln('Macintosh Plus keyboard with keypad');
            1:
                writeln('Macintosh keyboard');
            2:
                writeln(' Macintosh keyboard and keypad');
            3:
                writeln('Macintosh plus keyboard');
            4:
                writeln('Apple extended keyboard');
            5:
                writeln('Standard Apple Desktop bus keyboard');
            10:
                writeln('Macintosh LC keyboard');
            otherwise
                writeln('keyBoardType = ', SysEnvData.keyBoardType);
        end;

        dummy := MPPOpen;
        if (dummy = noErr) then
            begin
                dummy := SysEnvData.atDrvrVersNum;
                writeln('AppleTalk version = ', dummy);
            end
        else
            writeln('AppleTalk not installed');
    end;


{ *************** Sys6OrLater  ************************}
{*  This routine checks to see if Gestalt or SysEnvirons should be used          *}
{*************************************************}
    procedure Sys60rLater;
    begin
        if GestaltAvailable then
            UseGestalt
        else
            UseSysEnviron;
    end;


{ *************** SysInfo  ***************************}
{*  This is the main routine of the program.                                     *}
{*************************************************}
begin
    Sys60rLater;
    MenuBarInit;
    MainLoop;
end.